home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 20
/
Cream of the Crop 20 (Terry Blount) (1996).iso
/
comm
/
cpt152.zip
/
CPT-S152.ZIP
/
CPT-ST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-05-16
|
3KB
|
101 lines
PROGRAM Sort_or_Analyze_Conference_Participation_Tracker_Database;
{$M 5120,0,655360}
{$N-,E- no math support needed}
{$X- function calls may not be discarded}
{$I- disable I/O checking (trap errors by checking IOResult)}
USES DOS, NUMDAYS, CPT_CODE;
{$IFDEF sort}
CONST
progname='CPT-Sort';
progdesc = progname+version+'- Free DOS utility: Sort CPT Database.';
{$ENDIF}
{$IFDEF stat}
CONST
progname='CPT-Stat';
progdesc = progname+version+'- Free DOS utility: Produce statistics from CPT Database.';
{$ENDIF}
VAR SavedExitProc: POINTER;
{===========================================================================}
PROCEDURE CustomExit; FAR; {---- Always exit through here ----}
BEGIN
ExitProc := SavedExitProc;
cursorOn;
IF (ExitCode > 0) THEN BEGIN
WriteLn (progdesc);
WriteLn (author+lf);
WriteLn ('Usage: '+progname+' <CPT file> <sort order>'+lf);
WriteLn ('The "sort order" may be any one or more of the following:'+lf);
WriteLn (' name = sort by first name, ascending (A to Z)');
WriteLn (' -name = sort by first name, descending (Z to A)');
WriteLn (' sent = sort by messages sent, ascending (fewest messages at top)');
WriteLn (' -sent = sort by messages sent, descending (most messages at top)');
WriteLn (' oldest = sort by oldest message, ascending (new people at end)');
WriteLn (' -oldest = sort by oldest message, descending (new people at top)');
WriteLn (' newest = sort by newest message, ascending (current posters at end)');
WriteLn (' -newest = sort by newest message, descending (current posters at top)'+lf);
WriteLn ('Example: '+progname+' cnf_123.dat -sent');
WriteLn ('Example: '+progname+' 45.mem -sent name'+lf);
END;
IF ErrorAddr <> NIL THEN {If an unanticipated run-time error occured...}
BEGIN
WriteLn ('An unanticipated error occurred, please contact DDA with the following data:');
WriteLn ('Address = ', WordToHex (Seg (ErrorAddr^)), ':', WordToHex (Ofs (ErrorAddr^)));
WriteLn ('Code = ', ExitCode);
ErrorAddr := NIL; {IMPORTANT!!!}
END
ELSE
IF (ExitCode IN [1..254]) THEN
WriteError (ExitCode);
END;
{===========================================================================}
VAR MemberInfo : MemLink;
Members : WORD;
MemFileName : PATHSTR;
PCount : BYTE;
DotPos : BYTE;
BEGIN
SavedExitProc := ExitProc;
ExitProc := @CustomExit;
IF ParamCount < 2 THEN Halt (255);
MemFileName := GetConfNUMBER (ParamStr (1));
IF NOT IsFile (MemFileName) THEN Halt (1);
{$IFDEF sort}
WriteLn (progname+' resorting '+MemFileName);
{$ENDIF}
{$IFDEF stat}
WriteLn (progname+' analyzing '+MemFileName);
{$ENDIF}
Members := BuildList (MemberInfo, MemFileName); WriteLn;
IF MemberInfo <> NIL THEN BEGIN
FOR PCount := ParamCount DOWNTO 2 DO BEGIN
GetSortField (ParamStr (Pcount));
SortLinkedList (MemberInfo); WriteLn;
END;
{$IFDEF sort}
WriteList (MemberInfo, MemFileName, Members); WriteLn;
{$ENDIF}
{$IFDEF stat}
DotPos := Pos ('.', MemFileName);
IF DotPos > 0 THEN
Delete (MemFileName, DotPos, 1 + Length (MemFileName) - DotPos);
WriteStats (MemberInfo, MemFileName+ '.STT', Members);
WriteLn (lf+'Statistics are in: '+MemFileName+'.STT');
{$ENDIF}
END;
WriteLn ('Mission accomplished!');
END.